unit forthhandler;

interface

uses
  {windows,}
  basetype,sysutils,classes,httputils,httpfiletype,vm,linefs,uniutils;
const
  perrequest_kf='prerequest.kf';
type

 TKsanaForthVMWeb= class(TKsanaforthVM)
   public
   weboutput:TStringList;
   headers,queryfields:TStrings;

   constructor create(dictsize:cardinal=8192);override;
   destructor destroy;override;
 end;
 THttpHandlerKsp = class(THttpHandler)
 protected
 public
   function createwebengine:Tksanaforthvmweb;
   function processrequest:integer;  override;
 end;

var
  fontFile:wideString;
  daemonengine:TKsanaForthVm;
implementation
procedure forth_setcontenttype(vm:TKsanaForthVM);
var
  vmweb:TKsanaForthVMWeb;
  s,contenttype:string;
  i:integer;
begin
  vmweb:=TKsanaForthVMWeb(vm);
  contenttype:='Content-type: '+vm.gettibstr;


  for i:=0 to vmweb.headers.count-1 do begin
    s:=vmweb.headers[i];
    if lowercase(copy(s,1,12))='content-type' then begin
      //replace existing
      vmweb.headers[i]:=contenttype;
      exit;
    end;
  end;

  //specify the content-type
  vmweb.headers.add(contenttype);


end;

procedure kspinputcheck(vm:TKsanaForthVM);
begin vm.tos:=vm.tos;
end;

// urlparam :  -(name)- 0|saddr count
procedure kspztype(vm:TKsanaForthVM;p:pchar);
var
  vmweb:TKsanaForthVMWeb;
begin
  vmweb:=TKsanaForthVMWeb(vm);
  if p='' then exit;
  if vmweb.weboutput.count=0 then vmweb.weboutput.add('');
  vmweb.weboutput[vmweb.weboutput.count-1]:=
  vmweb.weboutput[vmweb.weboutput.count-1]+p;
end;

// urlparam :  -(name)- 0|saddr count
procedure kspwztype(vm:TKsanaForthVM;p:pwidechar);
var
  vmweb:TKsanaForthVMWeb;
begin

  vmweb:=TKsanaForthVMWeb(vm);
  if p='' then exit;
  if vmweb.weboutput.count=0 then vmweb.weboutput.add('');
  vmweb.weboutput[vmweb.weboutput.count-1]:=
  vmweb.weboutput[vmweb.weboutput.count-1]+widestringtoutf8(p);
end;

procedure kspemit(vm:TKsanaForthVM;c:char);
var
  vmweb:TKsanaForthVMWeb;
begin
  vmweb:=TKsanaForthVMWeb(vm);
  if vmweb.weboutput.count=0 then vmweb.weboutput.add('');  
  if c=#13 then begin
    vmweb.weboutput.Add('');
  end else begin
    vmweb.weboutput[vmweb.weboutput.count-1]:=
    vmweb.weboutput[vmweb.weboutput.count-1]+c;
  end;
end;

function THttpHandlerKsp.createwebengine:Tksanaforthvmweb;
var
  i:integer;
  v,s:string;
begin
  result:=TKsanaForthVMWeb.create;
  result.kdbroot := daemonengine.kdbroot ;
  result.tickinputcheck:=kspinputcheck;
  result.tickztype:=kspztype;
  result.tickemit:=kspemit;
  result.queryfields :=queryfields;
  result.headers:=headers;
  result.addcodeword('content-type:',integer(@forth_setcontenttype));

//  result.verbose :=true;
  //compile constant from queryfield parameters
  // $q  string ,  #q number
  {
  for i:=0 to queryfields.count-1 do begin
    v:=queryfields.ValueFromIndex[i];
    s:=': $'+queryfields.names[i]+' s" '+ v+'" ;';
    result.eval( s );

    s:=': #'+queryfields.names[i]+' '+ format('%d',[strtointdef(v,0)])+' ;';
    result.eval( s );
  end;
  }
end;

function THttpHandlerKsp.ProcessRequest:integer;
var
  ws,s:widestring;
  i,j:integer;
  raw:TLinedFileStream;
  script:tstringlist;
  engine:TKsanaForthVMWeb;
  inscript:boolean;
  scripts:string;
  scriptstart,scriptend,p2,p:pwidechar;
  tdiff,t:int64;
begin

  result := 200;

  headers.Clear;
  headers.Add('Content-type: text/html');
  headers.Add('Pragma: no-cache');

  raw:=TLinedFileStream.create(document);

  script:=tstringlist.create;
  t:=getcputick;
  engine:=createwebengine;
  engine.addvoc( daemonengine.voc );
  engine.quiting:=false;

  if fileexists(perrequest_kf) then engine.fload(perrequest_kf);
  i:=0;
  inscript:=false;
  while not raw.eof do begin
    engine.sourcelinenumber:=i+1;
    raw.readln;
    s:=raw.line;
    ws:=pwidechar(s);
    p:=pwidechar(s);
    scriptstart:=p;

    //this is quite messy, need restructure
    while p^<>#0 do begin

      if inscript then begin
        //scan for %>
        scriptend:=scriptstart;
        repeat
         scriptend:=strscanW(scriptend,widechar('%'));
         if scriptend=nil then break;
         if (scriptend^=#0) or ((scriptend+1)^='>') then break;
         inc(scriptend);
        until false;

        if scriptend=nil then begin
          script.add(widestringtoutf8(ws));
        end else begin //end here
          scriptend^:=#0;
          script.add(p);              // multiline script  <%
          
          for j:=0 to script.Count-1 do begin
            scripts:=pchar(script[j]);
            engine.eval(scripts);   //                      xxxx %>
            if engine.quiting then break;
            //if engine.exitloop then break;
          end;

          script.clear;
          if not engine.quiting then begin
            inscript:=false;
            scriptend^:='%';
            inc(scriptend,2);
            kspwztype(engine,scriptend);
          end;
        end;
        break;

      end else begin

      //look for <%
        p2:=p;
        repeat
          p2:=strscanw( p2,widechar('<'));
          if p2=nil then break;
          if (p2^=#0) or ((p2+1)^='%') then break;
          inc(p2);
        until false;

        if (p2<>nil) then begin  // has script begin marker
          //print leading text
          p2^:=#0;
          if (raw.count>1) and (p=pwidechar(s)) then engine.weboutput.add(''); // leading , add crlf
          if p^<>#0 then kspwztype(engine,p);
          p2^:='<';

          scriptstart:=p2+2;
          //scan for %>
          scriptend:=scriptstart;
          repeat
           scriptend:=strscanW(scriptend,widechar('%'));
           if (scriptend=nil) or (scriptend^=#0) or ((scriptend+1)^='>') then break;
           inc(scriptend);
          until false;


          if scriptend=nil then begin  //span across multiline
            inscript:=true;
            script.add(scriptstart);
            break;
          end else begin
            scriptend^:=#0;
            engine.eval(scriptstart);  // single line script <% xxxx %>
            scriptend^:='%';
            p:=scriptend+2;
          end;

        end else begin
          if integer(p)=integer(pwidechar(s)) then
            engine.weboutput.add(widestringtoutf8(p))
          else engine.weboutput[engine.weboutput.count-1]:=
            engine.weboutput[engine.weboutput.count-1]+widestringtoutf8(p);
          break;
        end;
      end;
    end;
    inc(i);
    if (s='') and not inscript then engine.weboutput.add('');
  end;
 // engine.weboutput.text:=trim(engine.weboutput.text);

  engine.weboutput.SaveToStream(outputdata);


  tdiff:=t-getcputick;
  writeln('page served in '+inttostr(getcputick)+' ticks');
  engine.free;
  script.free;
  raw.free;
end;

{ TKsanaForthVMWeb }

constructor TKsanaForthVMWeb.create;
begin
  inherited create(dictsize);
  weboutput:=TStringlist.create;
end;

destructor TKsanaForthVMWeb.destroy;
begin
  weboutput.free;
  inherited;
end;

initialization

  registerclass(THttpHandlerKsp);
end.
